home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / sfw10 / bigtext.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  30KB  |  1,048 lines
  1. unit BigText;
  2. { TBigText 1.1  (c) 1995 by Gerry Skolnik (skolnik@kapsch.co.at)
  3.                     Portions (c) 1995 by Danny Thorpe
  4.  
  5.   This is a simple component to display up to 32767 lines of text. Each line
  6.   has its own dedicated foreground and background color and can be 255 chars
  7.   long. Theoretically this amounts to about 8MB of data and beats the TMemo's
  8.   measly 32kB, however, no editing functions are available.
  9.  
  10.   TBigList is a no-frills TList mutant. I've implemented most of the
  11.   essential functions. Before fine-tuning I'd like to wait for Windows 95 /
  12.   Delphi 95, just in case TBigList is made redundant then.
  13.  
  14.   The limitation of TBigText is caused by the Windows API scrolling functions
  15.   insisting on being passed integer values, thus reducing the maximum amount
  16.   of lines a scrollbar can handle to 32767. However, display problems start
  17.   as soon as line 32750. As I couldn't see much difference between 32750 and
  18.   32767 lines, I haven't bothered to track this down. Be my guest.
  19.  
  20.   TBigText is FreeWare. You may use it freely at your own risk in any
  21.   kind of environment. This component is not to be sold at any charge, and
  22.   must be distributed along with the source code.
  23.  
  24.   The scrolling routines were taken from Danny Thorpe's TConsole object.
  25.  
  26.   BTW: while I claim the copyright to the original source code, this does
  27.   not mean that you may not modify or enhance it. Just add your credits,
  28.   and if you think you came up with some major improvement that the Delphi
  29.   community might find useful, upload it at some Delphi site.
  30.   Of course, any enhancement/modification must be released as Freeware.
  31.  
  32.   property MaxLines
  33.            if set to 0, as much lines as memory permits are included. The
  34.            absolute maximum, however, is 32767. If set to something else,
  35.            TBigText will limit itself to that many lines.
  36.  
  37.   property PurgeLines
  38.            determines how to handle the situation when no more lines can be
  39.            added (line count reached Maxlines value or we ran out of memory).
  40.            if set to 0, an exception is raised. If set to something different
  41.            (default 200) the number of lines specified by PurgeLines are
  42.            deleted, the TBigList objects are packed, and most likely more
  43.            lines can be added (though the first ones will be lost).
  44.            This option is useful for logging windows.
  45.  
  46.   property Count
  47.            run-time read-only. If the Lines and StringColor counts
  48.            are equal, this property holds the number of lines in TBigText.
  49.            If the two counts are unequal, there's something wrong and the
  50.            property holds a value of -1.
  51.  
  52.   procedure AddLine(LineString: string; FCol, BCol: TColor;
  53.             UpdateDisplay: boolean);
  54.            The essential routine to insert lines into TBigText.
  55.            LineString   : the text to be inserted
  56.            FCol         : forground color
  57.            BCol         : background color
  58.            UpdateDisplay: if true, TBigText will scroll to the last line
  59.                           (where the new line will be added), and update
  60.                           its display. This is not recommended if lots of
  61.                           lines are to be included in a loop.
  62.  
  63.   procedure LoadFromFile(FileName: TFileName);
  64.            Loads a file into TBigText. Every line will have the default colors
  65.            clWindowText, clWindow.
  66.  
  67.   procedure Print
  68.            prints all lines on the specified printer. Haven't
  69.            checked this out, though.
  70.  
  71.   procedure ChangeColor(Index: longint; OldFCol, OldBCol, NewFCol,
  72.            NewBCol: TColor);
  73.            changes the colors of the line at Index, but only if the
  74.            current colors match OldFCol and
  75.            OldBCol (FCol = foreground color, BCol = background color).
  76.  
  77.   the following procedures do pretty much the same as
  78.            the accodring TList methods:
  79.  
  80.            procedure Clear;
  81.            procedure Delete(Index: longint);
  82.            procedure Remove(Index: longint);
  83.            procedure Pack;
  84.  
  85.  
  86. *****************************************************************
  87. Function Search - Added EJH 07/04/95
  88. Search('this text', True, True);
  89. Parameters:
  90.       SrcWord  : String - What to Look for in the array
  91.       SrchDown : Bool - True - Search down; False - Search Up
  92.       MCase    : Bool - True - Match Case Exact; False - Disregard Case
  93.  
  94. Returns:       True - Found ; False - Not Found
  95.  
  96.       Note: This is a little screwy because it does not redisplay the
  97.             last page if text is found there when already on the last page.
  98.             Also, during displays of found data, on the last call, if the
  99.             user closes the finddialog, I could not see an automatic way
  100.             for this application to know that it was not visible, so the
  101.             final blue line stays on the screen untill the window scrolls
  102.             beyond it, from then on it is not there.  This is sometimes
  103.             useful, othertimes it is just ugly.
  104.  
  105.       Note: To find exact matches if you have the option available to the
  106.             user, put a space on both sides of SrcWord, otherwise partial
  107.             matches are used.
  108.  
  109. Modifications - Eric Heverly - July 1995 (erichev@ix.netcom.com)
  110.  
  111.        Scroll- Added keys F1-F4 to the Scrool Keys table.
  112.        Print - Added canvas font for the display canvas to the printer
  113.                so the expected printer font was the same.  Also added some
  114.                Cursor := crHourGlass to show that the system was busy during
  115.                print cycles.
  116.        Search- Added function.
  117.        GoPosi- GoPosition function added.
  118.        LoadFr- LoadFromFile added some Cursor := crHourGlass to show the
  119.                user that the system is busy.  Also I changed the call to the
  120.                addline function to use the dumchar, this keeps the font to
  121.                the defined font in the object editor (ie. I used Courier and
  122.                this way it kept Courier as the display font, with the OEM
  123.                characters, it always used the System font).
  124.  
  125. }
  126. interface
  127.  
  128. uses WinTypes, WinProcs, Messages, Classes, Controls, Printers,
  129.      Forms, Graphics, SysUtils;
  130.  
  131. type
  132.   {$M+}
  133.   TStringColor = class
  134.   public
  135.     FColor : TColor;
  136.     BColor : TColor;
  137.   end;
  138.   TBigList = class
  139.  
  140.     private
  141.     function GetCapacity: longint;
  142.     function GetCount: longint;
  143.     function GetItems(Index: longint): pointer;
  144.     procedure SetItems(Index: longint; const Item: pointer);
  145.   protected
  146.     ListCount : LongInt;
  147.     TheLines  : array[0..3] of TList;
  148.   published
  149.     property Capacity: longint read GetCapacity;
  150.     property Count: longint read GetCount;
  151.   public
  152.     property Items[Index: longint]: pointer read GetItems write SetItems;
  153.     constructor Create;
  154.     destructor Destroy;
  155.     class function ClassName: string;
  156.     function Add(Item: Pointer): longint;
  157.     procedure Delete(Index: longint);
  158.     procedure Remove(Index: longint);
  159.     procedure Pack;
  160.     procedure Clear;
  161.     function First: pointer;
  162.     function Last: pointer;
  163.   end;
  164.   {$M-}
  165.   TBigText = class(TCustomControl)
  166.   private
  167.     FFont: TFont;
  168.     FMaxLines: word;
  169.     FPurgeLines: word;
  170.     FColor : TColor;
  171.     procedure DoScroll(Which, Action, Thumb: LongInt);
  172.     procedure WMHScroll(var M: TWMHScroll); message wm_HScroll;
  173.     procedure WMVScroll(var M: TWMVScroll); message wm_VScroll;
  174.     procedure WMSize(var M: TWMSize); message wm_Size;
  175.     procedure WMGetDlgCode(var M: TWMGetDlgCode); message wm_GetDlgCode;
  176.     procedure SetFont(F: TFont);
  177.     function GetCount: longint;
  178.   protected
  179.     FRange: TPoint;
  180.     FOrigin: TPoint;
  181.     FClientSize: TPoint;
  182.     FCharSize: TPoint;
  183.     FOverhang: LongInt;
  184.     FPageSize: LongInt;
  185.     Lines: TBigList;
  186.     StringColor: TBigList;
  187.     procedure Paint; override;
  188.     procedure SetScrollbars;
  189.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  190.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  191.                 X, Y: Integer); override;
  192.   published
  193.     procedure RecalcRange;
  194.     procedure FontChanged(Sender: TObject);
  195.     property Font: TFont read FFont write SetFont;
  196.     property Align;
  197.     property ParentColor;
  198.     property MaxLines: word read FMaxLines write FMaxLines default 0;
  199.     property PurgeLines: word read FPurgeLines write FPurgeLines default 200;
  200.     property Color: TColor read FColor write FColor default clWindow;
  201.     property Count: longint read GetCount;
  202.   public
  203.     constructor Create(AnOwner: TComponent); override;
  204.     destructor Destroy; override;
  205.     procedure ScrollTo(X, Y: LongInt);
  206.     procedure AddLine(LineString: string; FCol, BCol: TColor; UpdateDisplay: boolean);
  207.     procedure Delete(Index: longint);
  208.     procedure Clear;
  209.     procedure Print;
  210.     function   CurPos : longint; {EJH}
  211.     function   GoPosition(GoPos: longint): bool;  { EJH }
  212.                {EJH - Search }
  213.     function   Search(SrcWord: string; SrchDown : Bool; MCase : Bool ): bool;
  214.     function   DoSearch(SrcWord:String; MCase:Bool; I:longint ): longint;
  215.     procedure  LoadFromFile(FileName: TFileName);
  216.     procedure  LoadFromFileANSI(FileName: TFileName); {EJH}
  217.     function   Printspec(const szWLine: String): Bool; {EJH }
  218.     function   GetLine(Index: longint): string;
  219.     procedure  ChangeColor(Index: longint; OldFCol, OldBCol, NewFCol, NewBCol: TColor);
  220.   end;
  221.  
  222. procedure Register;
  223.  
  224. implementation
  225.  
  226. { Scroll key definition record }
  227.  
  228. type
  229.   TScrollKey = record
  230.     sKey: Byte;
  231.     Ctrl: Boolean;
  232.     SBar: Byte;
  233.     Action: Byte;
  234.   end;
  235.  
  236. { Scroll keys table }
  237.  
  238. const
  239.   ScrollKeyCount = 16;    { EJH 07/04/95 from 12 to 16 for F1-F4 keys }
  240.   ScrollKeys: array[1..ScrollKeyCount] of TScrollKey = (
  241.     (sKey: vk_Left;  Ctrl: False; SBar: sb_Horz; Action: sb_LineUp),
  242.     (sKey: vk_Right; Ctrl: False; SBar: sb_Horz; Action: sb_LineDown),
  243.     (sKey: vk_Left;  Ctrl: True;  SBar: sb_Horz; Action: sb_PageUp),
  244.     (sKey: vk_Right; Ctrl: True;  SBar: sb_Horz; Action: sb_PageDown),
  245.     (sKey: vk_Home;  Ctrl: False; SBar: sb_Horz; Action: sb_Top),
  246.     (sKey: vk_End;   Ctrl: False; SBar: sb_Horz; Action: sb_Bottom),
  247.     (sKey: vk_Up;    Ctrl: False; SBar: sb_Vert; Action: sb_LineUp),
  248.     (sKey: vk_Down;  Ctrl: False; SBar: sb_Vert; Action: sb_LineDown),
  249.     (sKey: vk_Prior; Ctrl: False; SBar: sb_Vert; Action: sb_PageUp),
  250.     (sKey: vk_Next;  Ctrl: False; SBar: sb_Vert; Action: sb_PageDown),
  251.     (sKey: vk_F1;    Ctrl: False;  SBar: sb_Vert; Action: sb_PageDown),{EJH}
  252.     (sKey: vk_F2;    Ctrl: False;  SBar: sb_Vert; Action: sb_PageUp),  {EJH}
  253.     (sKey: vk_F3;    Ctrl: False;  SBar: sb_Vert; Action: sb_Top),     {EJH}
  254.     (sKey: vk_F4;    Ctrl: False;  SBar: sb_Vert; Action: sb_Bottom),  {EJH}
  255.     (sKey: vk_Home;  Ctrl: True;  SBar: sb_Vert; Action: sb_Top),
  256.     (sKey: vk_End;   Ctrl: True;  SBar: sb_Vert; Action: sb_Bottom));
  257.  
  258. var
  259.    szANSI : String;
  260.  
  261.  
  262. function Min(X, Y: LongInt): LongInt;
  263. begin
  264.   if X < Y then Min := X else Min := Y;
  265. end;
  266.  
  267. function Max(X, Y: LongInt): LongInt;
  268. begin
  269.   if X > Y then Max := X else Max := Y;
  270. end;
  271.  
  272. {<<<<<<<<<<<<<<<<<<<< TBigList >>>>>>>>>>>>>>>>>>>>>>>}
  273.  
  274. constructor TBigList.Create;
  275. begin
  276.   ListCount := 0;
  277.   TheLines[ListCount] := TList.Create;
  278. end;
  279.  
  280. destructor TBigList.Destroy;
  281. var
  282.   i: LongInt;
  283. begin
  284.   for i := 0 to ListCount do
  285.     TheLines[i].Free;
  286. end;
  287.  
  288. class function TBigList.ClassName: string;
  289. begin
  290.   ClassName := 'TBigList';
  291. end;
  292.  
  293. function TBigList.GetCapacity: longint;
  294. var
  295.   i: LongInt;
  296.   j: longint;
  297. begin
  298.   j := 0;
  299.   for i := 0 to ListCount do
  300.     inc(j, TheLines[i].Capacity);
  301.   GetCapacity := j;
  302. end;
  303.  
  304. function TBigList.GetCount: longint;
  305. var
  306.   i: LongInt;
  307.   j: longint;
  308. begin
  309.   j := 0;
  310.   for i := 0 to ListCount do
  311.     inc(j, TheLines[i].Count);
  312.   GetCount := j;
  313. end;
  314.  
  315. function TBigList.Add(Item: Pointer): longint;
  316. var
  317.   i: LongInt;
  318.   j: longint;
  319. begin
  320.   try
  321.     TheLines[ListCount].Add(Item);
  322.     j := 0;
  323.     for i := 0 to ListCount do
  324.       inc(j, TheLines[ListCount].Count);
  325.     Add := j - 1;
  326.   except
  327.     try
  328.       inc(ListCount);
  329.       TheLines[ListCount] := TList.Create;
  330.       TheLines[ListCount].Add(Item);
  331.       j := 0;
  332.       for i := 0 to ListCount do
  333.         inc(j, TheLines[i].Count);
  334.       Add := j - 1;
  335.     except
  336.       j := 0;
  337.       for i := 0 to (ListCount - 1) do
  338.         inc(j, TheLines[i].Count);
  339.       raise EOutOfResources.Create('Out of Memory at line ' + IntToStr(j));
  340.       Add := -1;
  341.     end;
  342.   end;
  343. end;
  344.  
  345. procedure TBigList.Delete(Index: longint);
  346. var
  347.   i: LongInt;
  348. begin
  349.   if Index > Count then
  350.     raise ERangeError.Create('TBigList Index out of bounds')
  351.   else
  352.   begin
  353.     i := 0;
  354.     while Index > (TheLines[i].Count - 1) do
  355.     begin
  356.       dec(Index, TheLines[i].Count);
  357.       inc(i);
  358.     end;
  359.     TheLines[i].Delete(Index);
  360.   end;
  361. end;
  362.  
  363. procedure TBigList.Remove(Index: longint);
  364. begin
  365.   Delete(Index);
  366. end;
  367.  
  368. procedure TBigList.Pack;
  369. var
  370.   i       : LongInt;
  371.   j       : longint;
  372.   ListFull: boolean;
  373. begin
  374.   TheLines[0].Pack;
  375.   i := 0;
  376.   while (i < ListCount) do
  377.   begin
  378.     try
  379.       TheLines[i].Add(TheLines[i + 1].Items[0]);
  380.       TheLines[i + 1].Delete(0);
  381.     except
  382.       inc(i);
  383.     end;
  384.   end;
  385.   TheLines[i].Pack;
  386.   for i := ListCount downto 1 do
  387.   begin
  388.     if TheLines[i].Count = 0 then
  389.       TheLines[i].Free;
  390.   end;
  391. end;
  392.  
  393. procedure TBigList.Clear;
  394. var
  395.   i: LongInt;
  396. begin
  397.   for i := 1 to ListCount do
  398.     TheLines[ListCount].Free;
  399.   ListCount := 0;
  400.   TheLines[ListCount].Clear;
  401. end;
  402.  
  403. function TBigList.First: pointer;
  404. begin
  405.   First := TheLines[0].Items[0];
  406. end;
  407.  
  408. function TBigList.Last: pointer;
  409. begin
  410.   Last := TheLines[ListCount].Items[TheLines[ListCount].Count - 1];
  411. end;
  412.  
  413. function TBigList.GetItems(Index: longint): pointer;
  414. var
  415.   i: LongInt;
  416. begin
  417.   if Index > Count then
  418.     raise ERangeError.Create('TBigList Index out of bounds')
  419.   else
  420.   begin
  421.     i := 0;
  422.     while Index > (TheLines[i].Count - 1) do
  423.     begin
  424.       dec(Index, TheLines[i].Count);
  425.       inc(i);
  426.     end;
  427.     GetItems := TheLines[i].Items[Index];
  428.   end;
  429. end;
  430.  
  431. procedure TBigList.SetItems(Index: longint; const Item: pointer);
  432. var
  433.   i: LongInt;
  434. begin
  435.   if Index > Count then
  436.     raise ERangeError.Create('TBigList Index out of bounds')
  437.   else
  438.   begin
  439.     i := 0;
  440.     while Index > (TheLines[i].Count - 1) do
  441.     begin
  442.       dec(Index, TheLines[i].Count);
  443.       inc(i);
  444.     end;
  445.     TheLines[i].Items[Index] := Item;
  446.   end;
  447. end;
  448.  
  449. {<<<<<<<<<<<<<<<<<<<< TBigText >>>>>>>>>>>>>>>>>>>>>>>}
  450.  
  451. constructor TBigText.Create(AnOwner: TComponent);
  452. begin
  453.   inherited Create(AnOwner);
  454.   Width := 320;
  455.   Height := 200;
  456.   ParentColor := False;
  457.   FFont := TFont.Create;
  458.   FFont.Name := 'Courier';
  459.   FFont.OnChange := FontChanged;
  460.   FColor := clWindow;
  461.   FMaxLines := 0;
  462.   FPurgeLines := 200;
  463.   FOrigin.X := 0;
  464.   FOrigin.Y := 0;
  465.   FontChanged(nil);
  466.   Enabled := True;
  467.   Lines := TBigList.Create;
  468.   StringColor := TBigList.Create;
  469. end;
  470.  
  471. destructor TBigText.Destroy;
  472. begin
  473.   Lines.Free;
  474.   StringColor.Free;
  475.   FFont.Free;
  476.   inherited Destroy;
  477. end;
  478.  
  479. procedure TBigText.FontChanged(Sender: TObject);
  480. var
  481.   DC: HDC;
  482.   Save: THandle;
  483.   Metrics: TTextMetric;
  484.   Temp: String;
  485. begin
  486.   DC := GetDC(0);
  487.   Save := SelectObject(DC, Font.Handle);
  488.   GetTextMetrics(DC, Metrics);
  489.   SelectObject(DC, Save);
  490.   ReleaseDC(0, DC);
  491.   with Metrics do
  492.   begin
  493.     FCharSize.X := tmAveCharWidth;
  494.     FCharSize.Y := tmHeight + tmExternalLeading;
  495.     FOverhang   := Max(tmOverhang, tmMaxCharWidth - tmAveCharWidth);
  496.     RecalcRange;
  497.     Invalidate;
  498.   end;
  499. end;
  500.  
  501. procedure TBigText.RecalcRange;
  502. begin
  503.   if HandleAllocated then
  504.   begin
  505.     FClientSize.X := ClientWidth div FCharSize.X;
  506.     FClientSize.Y := ClientHeight div FCharSize.Y;
  507.     FPageSize := FClientSize.Y;
  508.     FRange.X := Max(0, 255 - FClientSize.X);
  509.     FRange.Y := Max(0, Lines.Count - FClientSize.Y);
  510.     ScrollTo(Min(FOrigin.X, FRange.X), Min(FOrigin.Y, FRange.Y));
  511.     SetScrollBars;
  512.   end;
  513. end;
  514.  
  515. procedure TBigText.SetScrollBars;
  516. begin
  517.   if HandleAllocated then
  518.   begin
  519.     SetScrollRange(Handle, sb_Horz, 0, Max(1, FRange.X), False);
  520.     SetScrollPos(Handle, sb_Horz, FOrigin.X, True);
  521.     SetScrollRange(Handle, sb_Vert, 0, Max(1, FRange.Y), False);
  522.     SetScrollPos(Handle, sb_Vert, FOrigin.Y, True);
  523.   end;
  524. end;
  525.  
  526. procedure TBigText.Paint;
  527. var
  528.   i: longint;
  529.   R: TRect;
  530. begin
  531.   SetViewportOrg(Canvas.Handle, -FOrigin.X * FCharSize.X, 0);
  532.   i := FOrigin.Y;
  533.   while (i < Lines.Count) and (i < ((FOrigin.Y + FPageSize) + 1)) do
  534.   begin
  535.     Canvas.Font := FFont;
  536.     Canvas.Font.Color := TStringColor(StringColor.Items[i]).FColor;
  537.     Canvas.Brush.Color := TStringColor(StringColor.Items[i]).BColor;
  538.     TextOut(Canvas.Handle, 0, FCharSize.Y * (i - FOrigin.Y),
  539.             Lines.Items[i], StrLen(Lines.Items[i]));
  540.     inc(i);
  541.   end;
  542. end;
  543.  
  544. procedure TBigText.DoScroll(Which, Action, Thumb: LongInt);
  545. var
  546.   X, Y: LongInt;
  547. function GetNewPos(Pos, Page, Range: LongInt): LongInt;
  548. begin
  549.   case Action of
  550.     sb_LineUp: GetNewPos := Pos - 1;
  551.     sb_LineDown: GetNewPos := Pos + 1;
  552.     sb_PageUp: GetNewPos := Pos - Page;
  553.     sb_PageDown: GetNewPos := Pos + Page;
  554.     sb_Top: GetNewPos := 0;
  555.     sb_Bottom: GetNewPos := Range;
  556.     sb_ThumbPosition,
  557.     sb_ThumbTrack    : GetNewPos := Thumb;
  558.   else
  559.     GetNewPos := Pos;
  560.   end;
  561. end;
  562. begin
  563.   X := FOrigin.X;
  564.   Y := FOrigin.Y;
  565.   case Which of
  566.     sb_Horz: X := GetNewPos(X, FClientSize.X div 2, FRange.X);
  567.     sb_Vert: Y := GetNewPos(Y, FClientSize.Y, FRange.Y);
  568.   end;
  569.   ScrollTo(X, Y);
  570. end;
  571.  
  572. procedure TBigText.WMHScroll(var M: TWMHScroll);
  573. begin
  574.   DoScroll(sb_Horz, M.ScrollCode, M.Pos);
  575. end;
  576.  
  577. procedure TBigText.WMVScroll(var M: TWMVScroll);
  578. begin
  579.   DoScroll(sb_Vert, M.ScrollCode, M.Pos);
  580. end;
  581.  
  582. procedure TBigText.WMSize(var M: TWMSize);
  583. begin
  584.   inherited;
  585.   RecalcRange;
  586. end;
  587.  
  588. procedure TBigText.ScrollTo(X, Y: LongInt);
  589. var
  590.   R: TRect;
  591.   OldOrigin: TPoint;
  592. begin
  593.   X := Max(0, Min(X, FRange.X));  { check boundaries }
  594.   Y := Max(0, Min(Y, FRange.Y));
  595.   if (X <> FOrigin.X) or (Y <> FOrigin.Y) then
  596.   begin
  597.     OldOrigin := FOrigin;
  598.     FOrigin.X := X;
  599.     FOrigin.Y := Y;
  600.     if HandleAllocated then
  601.     begin
  602.       R := Parent.ClientRect;  { EJH added Parent. }
  603.       ScrollWindowEx(Handle, (OldOrigin.X - X) * FCharSize.X,
  604.                      (OldOrigin.Y - Y) * FCharSize.Y,
  605.                      nil, @R, 0, @R, 0);
  606.       if Y <> OldOrigin.Y then
  607.         SetScrollPos(Handle, sb_Vert, Y, True);
  608.       if X <> OldOrigin.X then
  609.         SetScrollPos(Handle, sb_Horz, X, True);
  610.       InvalidateRect(Handle, @R, true);
  611.       Update;
  612.     end;
  613.   end;
  614. end;
  615.  
  616. procedure TBigText.AddLine(LineString: string; FCol, BCol: TColor; UpdateDisplay: boolean);
  617. var
  618.   DumChar: array[0..255] of char;
  619.   WhereY : LongInt;
  620.   i      : LongInt;
  621.   LeCol  : TStringColor;
  622. begin
  623.   if FMaxLines <> 0 then
  624.   begin
  625.     if (Lines.Count >= FMaxLines) or (Lines.Count > 32000) then
  626.     begin
  627.       if PurgeLines <> 0 then
  628.       begin
  629.         for i := 1 to PurgeLines do
  630.         begin
  631.           Lines.Delete(0);
  632.           StringColor.Delete(0);
  633.         end;
  634.         Lines.Pack;
  635.         StringColor.Pack;
  636.       end
  637.       else
  638.         raise ERangeError.Create('Maximum line count at line ' + IntToStr(Lines.Count))
  639.     end;
  640.   end;
  641.   try
  642.     Lines.Add(StrNew(StrPCopy(DumChar, LineString)));
  643.     LeCol := TStringColor.Create;
  644.     LeCol.FColor := FCol;
  645.     LeCol.BColor := BCol;
  646.     StringColor.Add(LeCol);
  647.   except
  648.     if PurgeLines <> 0 then
  649.     begin
  650.       for i := 1 to PurgeLines do
  651.       begin
  652.         Lines.Delete(0);
  653.         StringColor.Delete(0);
  654.       end;
  655.       Lines.Pack;
  656.       StringColor.Delete(0);
  657.       try
  658.         Lines.Add(StrNew(StrPCopy(DumChar, LineString)));
  659.         LeCol := TStringColor.Create;
  660.         LeCol.FColor := FCol;
  661.         LeCol.BColor := BCol;
  662.         StringColor.Add(LeCol);
  663.       except
  664.         raise EOutOfResources.Create('Out of Memory at line ' + IntToStr(Lines.Count))
  665.       end;
  666.     end
  667.     else
  668.       raise EOutOfResources.Create('Out of Memory at line ' + IntToStr(Lines.Count))
  669.   end;
  670.   if UpdateDisplay then
  671.   begin
  672.     SetViewportOrg(Canvas.Handle, 0, 0);
  673.     RecalcRange;
  674.     WhereY := Min(Lines.Count - 1, FPageSize);
  675.     Canvas.Font := FFont;
  676.     Canvas.Font.Color := TStringColor(StringColor.Items[Lines.Count -1]).FColor;
  677.     Canvas.Brush.Color := TStringColor(StringColor.Items[Lines.Count -1]).BColor;
  678.     TextOut(Canvas.Handle, 0, FCharSize.Y * WhereY,
  679.             Lines.Items[Lines.Count - 1], StrLen(Lines.Items[Lines.Count -1]));
  680.     ScrollTo(0, FRange.Y);
  681.   end;
  682. end;
  683.  
  684. procedure TBigText.Delete(Index: longint);
  685. begin
  686.   Lines.Delete(Index);
  687.   StringColor.Delete(Index);
  688. end;
  689.  
  690. procedure TBigText.Clear;
  691. begin
  692.   Lines.Clear;
  693.   StringColor.Clear;
  694.   RecalcRange;
  695.   Invalidate;
  696. end;
  697.  
  698.  
  699. procedure TBigText.Print;
  700. var
  701.   i: LongInt;
  702.   f: Textfile;
  703. begin
  704.   cursor := crHourGlass;           { Added EJH 7/5/95 }
  705.   AssignPrn(f);
  706.   Rewrite(f);
  707.   cursor := crHourGlass;           { Added EJH 7/5/95 }
  708.   Printer.Canvas.Font := FFont;    { Added EJH 7/5/95 }
  709.   for i := 0 to (Lines.Count - 1) do
  710.            WriteLn(f, StrPas(Lines.Items[i]));
  711.   System.Close(f);
  712.   cursor := crDefault;             { Added EJH 7/5/95 }
  713. end;
  714.  
  715. {
  716. Added - EJH
  717. }
  718. function TBigText.CurPos : longint;
  719. begin
  720.      Result := Forigin.Y;
  721. end;
  722. {
  723. Function GoPosition - Added EJH 07/11/95
  724. Parameters:
  725.       GoPos : Integer - Position to go to 1-N.
  726.  
  727.       Returns False if GoPos is > maximum lines.  True otherwise.
  728. }
  729. function TBigText.GoPosition(GoPos: longint): bool;
  730. var
  731.   Y :  longint;
  732.   X :  longint;
  733.   LC:  longint;
  734. begin
  735.   Y      := FOrigin.Y;
  736.   X      := FOrigin.X;
  737.   LC     := Lines.Count;
  738.   result := False;
  739.   if GoPos > 0 then
  740.     begin
  741.       if LC > GoPos then
  742.         begin
  743.          Y := GoPos;
  744.          ScrollTo(X, Y);
  745.          result := true;
  746.         end;
  747.     end;
  748.   end;
  749.  
  750. {
  751. Function Search - Added EJH 07/04/95
  752. Parameters:
  753.       SrcWord  : String - What to Look for in the array
  754.       SrchDown : Bool - True - Search down; False - Search Up
  755.       MCase    : Bool - True - Match Case Exact; False - Disregard Case
  756.  
  757.       Note: This is a little screwy because it does not redisplay the
  758.             last page if text is found there, the re-drawn then found
  759.             again on that line.
  760. }
  761. function TBigText.Search(SrcWord: string; SrchDown : Bool; MCase : Bool): bool;
  762. var
  763.   Y:     longint;
  764.   X:     longint;
  765.   fnd:   longint;
  766.   index: longint;
  767.   I:     longint;
  768.   LC:    longint;
  769.   SavCol:TColor;
  770. begin
  771.   Y   := FOrigin.Y;
  772.   X   := FOrigin.X;
  773.   fnd := 0;
  774.   I   := Y;
  775.   LC  := Lines.Count;
  776.   if SrchDown then
  777.      begin
  778.        while I < (LC - 1) do
  779.              begin
  780.                  I := I + 1;
  781.                  fnd := DoSearch(SrcWord, MCase, I);
  782.                  if fnd > 0 then
  783.                   begin
  784.                     index := I;
  785.                     I := Lines.Count;
  786.                   end;
  787.               end;
  788.     end
  789.   else
  790.     begin
  791.          while I > 0 do
  792.              begin
  793.                  I   := I - 1;
  794.                  fnd := DoSearch(SrcWord, MCase, I);
  795.                  if fnd > 0 then
  796.                   begin
  797.                     index := I;
  798.                     I := 0;
  799.                   end;
  800.               end;
  801.     end;
  802.   if fnd > 0 then
  803.      begin
  804.         Y := index;
  805.         SavCol := TStringColor(StringColor.Items[Index]).BColor;
  806.         ChangeColor(Y,
  807.            (TStringColor(StringColor.Items[Index]).FColor),
  808.            SavCol,
  809.            (TStringColor(StringColor.Items[Index]).FColor),
  810.            $00FF0000);
  811.         invalidate;
  812.         ScrollTo(X, Y);
  813.         ChangeColor(Y,
  814.            (TStringColor(StringColor.Items[Index]).FColor),
  815.            $00FF0000,
  816.            (TStringColor(StringColor.Items[Index]).FColor),
  817.            SavCol);
  818.         result := true;
  819.      end
  820.   else
  821.      begin
  822.         result := false;
  823.      end;
  824. end;
  825.  
  826. function TBigText.DoSearch(SrcWord:String; MCase:Bool; I:longint ): longint;
  827. begin
  828.    if MCase then
  829.       result := pos(SrcWord, StrPas(Lines.Items[I]))
  830.    else
  831.       result := pos(UpperCase(SrcWord),
  832.                     UpperCase(StrPas(Lines.Items[I])));
  833. end;
  834.  
  835. procedure TBigText.LoadFromFile(FileName: TFileName);
  836. var
  837.   f: TextFile;
  838.   i: LongInt;
  839.   ReadLine: string;
  840.   DumChar: array[0..255] of char;
  841.   OEMDumChar: array[0..255] of char;
  842. begin
  843.   Clear;
  844.   Cursor := crHourGlass;     { EJH 07/04/95 }
  845.   AssignFile(f, FileName);
  846.   Reset(f); 
  847.   while not eof(f) do
  848.   begin
  849.     ReadLn(f, ReadLine);
  850.     while pos(#$9, ReadLine) > 0 do
  851.     begin
  852.       Cursor := crHourGlass;
  853.       i := pos(#$9, ReadLine);
  854.       System.delete(ReadLine, i, 1);
  855.       while (i mod 8) <> 0 do
  856.       begin
  857.         insert(' ', ReadLine, i);
  858.         inc(i);
  859.       end;
  860.     end;
  861.     StrPCopy(DumChar, ReadLine);
  862.     OEMToAnsi(DumChar, OEMDumChar);
  863.     {AddLine(StrPas(OEMDumChar), clWindowText, clWindow, false);}
  864.     AddLine(StrPas(DumChar), clWindowText, clWindow, false); {EJH}
  865.   end;
  866.   CloseFile(f);
  867.   Cursor := crDefault;  {EJH}
  868.   RecalcRange;
  869.   Invalidate;
  870. end;
  871.  
  872. procedure TBigText.LoadFromFileANSI(FileName: TFileName);
  873. var
  874.   f: TextFile;
  875.   i: LongInt;
  876.   ReadLine: string;
  877.   DumChar: array[0..255] of char;
  878.   OEMDumChar: array[0..255] of char;
  879.   ansil : string;
  880. begin
  881.   Clear;
  882.   Cursor := crHourGlass;     { EJH 07/04/95 }
  883.   AssignFile(f, FileName);
  884.   Reset(f);
  885.   while not eof(f) do
  886.   begin
  887.     ReadLn(f, ReadLine);
  888.     ansil := Copy (ReadLine, 2, Length(Readline) - 1);
  889.  
  890.     if Readline[1] = '@' then
  891.        begin
  892.           Printspec(ansil);
  893.           ReadLine := Copy(szANSI, 1, Length(szANSI) - 1);
  894.        end
  895.     else
  896.        begin
  897.           ReadLine := Copy(ansil, 1, Length(ansil));
  898.        end;
  899.  
  900.     while pos(#$9, ReadLine) > 0 do
  901.     begin
  902.       Cursor := crHourGlass;
  903.       i := pos(#$9, ReadLine);
  904.       System.delete(ReadLine, i, 1);
  905.       while (i mod 8) <> 0 do
  906.       begin
  907.         insert(' ', ReadLine, i);
  908.         inc(i);
  909.       end;
  910.     end;
  911.     StrPCopy(DumChar, ReadLine);
  912.     OEMToAnsi(DumChar, OEMDumChar);
  913.     {AddLine(StrPas(OEMDumChar), clWindowText, clWindow, false);}
  914.     AddLine(StrPas(DumChar), clWindowText, clWindow, false); {EJH}
  915.   end;
  916.   CloseFile(f);
  917.   Cursor := crDefault;  {EJH}
  918.   RecalcRange;
  919.   Invalidate;
  920. end;
  921.  
  922. {
  923. Function Clears up the @@ line markers
  924. }
  925. function  TBigText.Printspec(const szWLine: String): Bool;
  926. var
  927. szFont   :  String;
  928. cCh      :  Char;
  929. iPos     :  LongInt;
  930. iTrail   :  LongInt;
  931. iLength  :  LongInt;
  932. bDouble  :  Bool;
  933. szLine   :  String;
  934. begin
  935.      iPos   := 0;
  936.      szANSI := '';
  937.      szLine := '';
  938.      bDouble:= False;
  939.      iLength := Length(szWLine);
  940.      while iPos < iLength - 1 do
  941.      begin
  942.           iPos := iPos + 1;
  943.           if iPos < 255 then
  944.             begin
  945.               if szWLine[iPos] = '@' then
  946.                begin
  947.                 iTrail := iPos + 1;           { Use next byte for check }
  948.                 if szWLine[iTrail] = '@' then { Found Signal }
  949.                     begin
  950.                         iPos := iPos + 2;     { Reset pointer }
  951.                         case szWLine[iPos] of
  952.                         'N', '1' : begin { N0, N2, N7, 10, 12, 17 cpi}
  953.                                    iPos := iPos + 2;
  954.                                    bDouble := False;
  955.                                    end;
  956.                              'D' : begin { D0, D2, D7 - Double Wide }
  957.                                    bDouble := True;
  958.                                    iPos := iPos + 2;
  959.                                    end;
  960.                         '6', '8' : begin { @@6L  &  @@8L }
  961.                                    bDouble := False;
  962.                                    iPos := iPos + 2;
  963.                                    end;
  964.                         else               { Do nothing...}
  965.                         end;
  966.                 end;
  967.             end;
  968.             if bDouble then
  969.                begin
  970.                   AppendStr(szLine, ' ');
  971.                   AppendStr(szLine, szWLine[iPos]);
  972.                end
  973.             else
  974.                 AppendStr(szLine, szWline[iPos]);
  975.        end;    { End of while statement }
  976.      end;      { End of if ipos < 255 }
  977.      AppendStr(szANSI, szLine);
  978. end;
  979.  
  980.  
  981.  
  982. function TBigText.GetLine(Index: longint): string;
  983. begin
  984.   if Index < Lines.Count then
  985.     GetLine := StrPas(Lines.Items[Index])
  986.   else
  987.     GetLine := '';
  988. end;
  989.  
  990. procedure TBigText.SetFont(F: TFont);
  991. begin
  992.   FFont.Assign(F);
  993. end;
  994.  
  995. procedure TBigText.KeyDown(var Key: Word; Shift: TShiftState);
  996. var
  997.   I: LongInt;
  998. begin
  999.   inherited KeyDown(Key, Shift);
  1000.   if Key <> 0 then
  1001.   begin
  1002.     for I := 1 to ScrollKeyCount do
  1003.       with ScrollKeys[I] do
  1004.         if (sKey = Key) and (Ctrl = (Shift = [ssCtrl])) then
  1005.         begin
  1006.       DoScroll(SBar, Action, 0);
  1007.       Exit;
  1008.         end;
  1009.   end;
  1010. end;
  1011.  
  1012. procedure TBigText.MouseDown(Button: TMouseButton;
  1013.   Shift: TShiftState; X, Y: Integer);
  1014. begin
  1015.   SetFocus;
  1016.   inherited MouseDown(Button, Shift, X, Y);
  1017. end;
  1018.  
  1019. procedure TBigText.WMGetDlgCode(var M: TWMGetDlgCode);
  1020. begin
  1021.   M.Result := dlgc_WantArrows or dlgc_WantChars;
  1022. end;
  1023.  
  1024. procedure TBigText.ChangeColor(Index: longint; OldFCol, OldBCol, NewFCol, NewBCol: TColor);
  1025. begin
  1026.   if (TStringColor(StringColor.Items[Index]).FColor = OldFCol) and
  1027.      (TStringColor(StringColor.Items[Index]).BColor = OldBCol) then
  1028.   begin
  1029.    TStringColor(StringColor.Items[Index]).FColor := NewFCol;
  1030.    TStringColor(StringColor.Items[Index]).BColor := NewBCol;
  1031.   end;
  1032. end;
  1033.  
  1034. function TBigText.GetCount: longint;
  1035. begin
  1036.   if Lines.Count = StringColor.Count then
  1037.     GetCount := Lines.Count
  1038.   else
  1039.     GetCount := -1;
  1040. end;
  1041.  
  1042. procedure Register;
  1043. begin
  1044.   RegisterComponents('FreeWare', [TBigText]);
  1045. end;
  1046.  
  1047. end.
  1048.